home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmObjects.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  47.7 KB  |  1,604 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                          GmObjects.pas v2.61 Pro                             }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmObjects;
  14.  
  15. interface
  16.  
  17. uses Windows, Classes, GmTypes, Graphics, GmStream, GmPrinter;
  18.  
  19. type
  20.   // Conditional define which gives information on the compiler version...
  21.  
  22.   {$I GMPS.INC}
  23.  
  24.   // *** GmObjects ***
  25.  
  26.   TGmBaseObject = class(TGmCustomBaseObject)
  27.   private
  28.     FShapeID: integer;
  29.     FRect: TRect;
  30.     FPreviewPage: integer;
  31.     FPrintThisObject: Boolean;
  32.     // clip properties...
  33.     FClipObject: Boolean;
  34.     FClipRect: TRect;
  35.     // canvas properties...
  36.     FBrush: TGmBrush;
  37.     FFont: TGmFont;
  38.     FPen: TGmPen;
  39.     function GetX: integer;
  40.     function GetX2: integer;
  41.     function GetY: integer;
  42.     function GetY2: integer;
  43.     procedure SetX(const NewX: integer);
  44.     procedure SetX2(const NewX2: integer);
  45.     procedure SetY(const NewY: integer);
  46.     procedure SetY2(const NewY2: integer);
  47.   public
  48.     constructor Create; virtual;
  49.     procedure Assign(Source: TGmBaseObject); virtual;
  50.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); virtual;
  51.     procedure SaveToStream(AStream: TStream); override;
  52.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  53.     procedure OffsetObject(inchX, inchY: Extended); virtual;
  54.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); virtual;
  55.     // properties...
  56.     property ClipObject: Boolean read FClipObject write FClipObject;
  57.     property ClipRect: TRect read FClipRect write FClipRect;
  58.     property CoordsAsRect: TRect read FRect write FRect;
  59.     property X: Integer read GetX write SetX;
  60.     property Y: Integer read GetY write SetY;
  61.     property X2: integer read GetX2 write SetX2;
  62.     property Y2: integer read GetY2 write SetY2;
  63.     property ShapeID: integer read FShapeID;
  64.     property Page: integer read FPreviewPage write FPreviewPage;
  65.     property PrintThisObject: Boolean read FPrintThisObject write FPrintThisObject default True;
  66.     // canvas properties...
  67.     property Brush: TGmBrush read FBrush write FBrush;
  68.     property Font: TGmFont read FFont write FFont;
  69.     property Pen: TGmPen read FPen write FPen;
  70.   end;
  71.  
  72.   TGmTextObject = class(TGmBaseObject)
  73.   private
  74.     FAlignment: TAlignment;
  75.     FCaption: string;
  76.     FPreview: TGmCustomPreview;
  77.   public
  78.     constructor Create; override;
  79.     procedure Assign(Source: TGmBaseObject); override;
  80.     procedure SaveToStream(AStream: TStream); override;
  81.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  82.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  83.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  84.     procedure SetFontColor(AColor: TColor);
  85.     procedure SetBrushColor(AColor: TColor);
  86.     procedure SetBrushStyle(AStyle: TBrushStyle);
  87.     procedure SetTextAngle(AValue: Extended);
  88.     // properties...
  89.     property Alignment: TAlignment read FAlignment write FAlignment;
  90.     property Caption: string read FCaption write FCaption;
  91.     property Preview: TGmCustomPreview read FPreview write FPreview;
  92.   end;
  93.  
  94.   TGmTextBoxObject = class(TGmTextObject)
  95.   private
  96.     FAlignment: TAlignment;
  97.     FVertAlignment: TGmVertAlignment;
  98.     FWordBreak: Boolean;
  99.   public
  100.     constructor Create; override;
  101.     procedure Assign(Source: TGmBaseObject); override;
  102.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  103.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  104.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  105.     procedure SaveToStream(AStream: TStream); override;
  106.     property Alignment: TAlignment read FAlignment write FAlignment;
  107.     property VertAlignment: TGmVertAlignment read FVertAlignment write FVertAlignment;
  108.     property WordBreak: Boolean read FWordBreak write FWordBreak default True;
  109.   end;
  110.  
  111.   TGmGraphicObject = class(TGmBaseObject)
  112.   private
  113.     FCopyMode: TCopyMode;
  114.     FDrawAsBitmap: Boolean;
  115.     FGraphic: TGraphic;
  116.     FPrintAsBitmap: Boolean;
  117.     FTransparentColor: TColor;
  118.     function GetGraphicType: TGmGraphicType;
  119.     procedure SetGraphic(const AGraphic: TGraphic);
  120.   public
  121.     constructor Create; override;
  122.     destructor Destroy; override;
  123.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  124.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  125.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  126.     procedure SaveToStream(AStream: TStream); override;
  127.     property CopyMode: TCopyMode read FCopyMode write FCopyMode;
  128.     property DrawAsBitmap: Boolean read FDrawAsBitmap write FDrawAsBitmap default False;
  129.     property Graphic: TGraphic read FGraphic write SetGraphic;
  130.     property GraphicType: TGmGraphicType read GetGraphicType;
  131.     property PrintAsBitmap: Boolean read FPrintAsBitmap write FPrintAsBitmap default False;
  132.     property TransparentColor: TColor read FTransparentColor write FTransparentColor;
  133.   end;
  134.   
  135.   TGmLineObject = class(TGmBaseObject)
  136.   private
  137.     FLineType: TGmLineType;
  138.   public
  139.     constructor Create; override;
  140.     procedure Assign(Source: TGmBaseObject); override;
  141.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  142.     procedure SaveToStream(AStream: TStream); override;
  143.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  144.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  145.     property LineType: TGmLineType read FLineType write FLineType default GmLine;
  146.   end;
  147.  
  148.   TGmSimpleShape = class(TGmBaseObject)
  149.   public
  150.     procedure SaveToStream(AStream: TStream); override;
  151.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  152.     procedure AssignBrush(ABrush: TBrush);
  153.     procedure AssignPen(APen: TPen);
  154.     procedure SetBrushColor(AColor: TColor);
  155.     procedure SetBrushStyle(AStyle: TBrushStyle);
  156.     procedure SetPenColor(AColor: TColor);
  157.     procedure SetPenStyle(AStyle: TPenStyle);
  158.     procedure SetPenWidth(AWidth: Integer);
  159.     procedure SetPenMode(AMode: TPenMode);
  160.   end;
  161.  
  162.   TGmEllipseShape = class(TGmSimpleShape)
  163.   public
  164.     constructor Create; override;
  165.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  166.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  167.   end;
  168.  
  169.   TGmRectangleShape = class(TGmSimpleShape)
  170.   private
  171.     FRectType: TGmRectType;
  172.   public
  173.     constructor Create; override;
  174.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  175.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  176.     property RectType: TGmRectType read FRectType write FRectType;
  177.   end;
  178.  
  179.   TGmRoundRectShape = class(TGmSimpleShape)
  180.   private
  181.     FX3: Integer;
  182.     FY3: Integer;
  183.   public
  184.     constructor Create; override;
  185.     procedure Assign(Source: TGmBaseObject); override;
  186.     procedure SaveToStream(AStream: TStream); override;
  187.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  188.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  189.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  190.     property X3: Integer read FX3 write FX3;
  191.     property Y3: Integer read FY3 write FY3;
  192.   end;
  193.  
  194.   TGmComplexShape = class(TGmSimpleShape)
  195.   private
  196.     FX3: Integer;
  197.     FY3: Integer;
  198.     FX4: Integer;
  199.     FY4: Integer;
  200.     function GetComplexPoints: TGmComplexPoints;
  201.   public
  202.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  203.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  204.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  205.     procedure SaveToStream(AStream: TStream); override;
  206.     // properties...
  207.     property X3: Integer read FX3 write FX3;
  208.     property Y3: Integer read FY3 write FY3;
  209.     property X4: Integer read FX4 write FX4;
  210.     property Y4: Integer read FY4 write FY4;
  211.   end;
  212.  
  213.   TGmArcShape = class(TGmComplexShape)
  214.   public
  215.     constructor Create; override;
  216.   end;
  217.  
  218.   TGmChordShape = class(TGmComplexShape)
  219.   public
  220.     constructor Create; override;
  221.   end;
  222.  
  223.   TGmPieShape = class(TGmComplexShape)
  224.   public
  225.     constructor Create; override;
  226.   end;
  227.  
  228.   {$IFDEF D4+}
  229.  
  230.   TGmPolyBaseObject = class(TGmBaseObject)
  231.   public
  232.     Points: array of TPoint;
  233.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  234.     procedure SaveToStream(AStream: TStream); override;
  235.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  236.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  237.   end;
  238.  
  239.   TGmPolygonObject = class(TGmPolyBaseObject)
  240.   public
  241.     constructor Create; override;
  242.   end;
  243.  
  244.   TGmPolyLineObject = class(TGmPolyBaseObject)
  245.   public
  246.     constructor Create; override;
  247.   end;
  248.  
  249.   TGmPolyLineToObject = class(TGmPolyBaseObject)
  250.   public
  251.     constructor Create; override;
  252.   end;
  253.  
  254.   TGmPolyBezierObject = class(TGmPolyBaseObject)
  255.   public
  256.     constructor Create; override;
  257.   end;
  258.  
  259.   TGmPolyBezierToObject = class(TGmPolyBaseObject)
  260.   public
  261.     constructor Create; override;
  262.   end;
  263.  
  264.   {$ENDIF}
  265.  
  266.   TGmPathObjectType = (gmBeginPath, gmEndPath, gmFillPath, gmStrokePath,
  267.     gmStrokeAndFillPath, gmCloseFigure);
  268.  
  269.   TGmPathObject = class(TGmBaseObject)
  270.   private
  271.     FObjectType: TGmPathObjectType;
  272.   public
  273.     constructor Create; override;
  274.     procedure Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN); override;
  275.     procedure LoadFromStream(AVersion: Extended; AStream: TStream); override;
  276.     procedure Print(APrinter: TGmPrinter; MarginRgn: HRGN); override;
  277.     procedure SaveToStream(AStream: TStream); override;
  278.     property ObjectType: TGmPathObjectType read FObjectType write FObjectType;
  279.   end;
  280.  
  281.   procedure GmBrushToBrush(ABrush: TBrush; AGmBrush: TGmBrush);
  282.   procedure GmFontToFont(AFont: TFont; AGmFont: TGmFont);
  283.   procedure GmPenToPen(ACanvas: TCanvas; APen: TPen; AGmPen: TGmPen);
  284.  
  285. implementation
  286.  
  287.  
  288. uses GmPreview, JPeg, GmConst;
  289.  
  290. //------------------------------------------------------------------------------
  291.  
  292.  
  293.  
  294. procedure GmBrushToBrush(ABrush: TBrush; AGmBrush: TGmBrush);
  295. begin
  296.   ABrush.Color  := AGmBrush.Color;
  297.   ABrush.Style  := AGmBrush.Style;
  298. end;
  299.  
  300. procedure GmFontToFont(AFont: TFont; AGmFont: TGmFont);
  301. begin
  302.   AFont.Size  := AGmFont.Size;
  303.   AFont.Color := AGmFont.Color;
  304.   AFont.Name  := AGmFont.Name;
  305.   AFont.Style := AGmFont.Style;
  306. end;
  307.  
  308. procedure GmPenToPen(ACanvas: TCanvas; APen: TPen; AGmPen: TGmPen);
  309. begin
  310.   APen.Color := AGmPen.Color;
  311.   APen.Style := AGmPen.Style;
  312.   APen.Width := AGmPen.Width;
  313.   APen.Mode  := AGmPen.Mode;
  314.   //ACanvas.Pen.Assign(APen);
  315.   if ACanvas <> nil then SelectPenIntoCanvas(APen, ACanvas);
  316. end;
  317.  
  318. function SelectFontIntoCanvas(AFont: TFont; Angle: Extended; ACanvas: TCanvas): HFont;
  319. var
  320.   lf: TLogFont;
  321. begin
  322.   GetObject(ACanvas.font.Handle, sizeof(lf), @lf);
  323.   lf.lfEscapement := Round(Angle * 10);
  324.   lf.lfOrientation := Round(Angle * 10);
  325.   if fsBold in ACanvas.font.Style then lf.lfWeight := FW_ULTRABOLD;
  326.   if fsItalic in ACanvas.font.Style then lf.lfItalic := Integer(True);
  327.   if fsUnderline in ACanvas.font.Style then lf.lfUnderline := Integer(True);
  328.   Result := CreateFontIndirect(lf);
  329. end;
  330.  
  331. function MetafileToBitmap(W, H: integer; AMetafile: TMetafile): TBitmap;
  332. begin
  333.   Result := TBitmap.Create;
  334.   Result.Width := W;
  335.   Result.Height := H;
  336.   Result.PixelFormat := pf24Bit;
  337.   PlayEnhMetaFile(Result.Canvas.Handle, AMetafile.Handle, Rect(0,0,W,H));
  338. end;
  339.  
  340. //------------------------------------------------------------------------------
  341.  
  342. {$IFDEF D4+}
  343.  
  344. // polygon object drawing routines...
  345.  
  346. type
  347.   PPoints = ^TPoints;
  348.   TPoints = array[0..0] of TPoint;
  349.  
  350. procedure DrawPolygon(ACanvas: TCanvas; const Points: array of TPoint);
  351. begin
  352.   Windows.Polygon(ACanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  353. end;
  354.  
  355. procedure DrawPolyline(ACanvas: TCanvas; const Points: array of TPoint);
  356. begin
  357.   Windows.Polyline(ACanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  358. end;
  359.  
  360. procedure DrawPolyBezier(ACanvas: TCanvas; const Points: array of TPoint);
  361. begin
  362.   Windows.PolyBezier(ACanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  363. end;
  364.  
  365. procedure DrawPolyLineTo(ACanvas: TCanvas; const Points: array of TPoint);
  366. begin
  367.   Windows.PolylineTo(ACanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  368. end;
  369.  
  370. procedure DrawPolyBezierTo(ACanvas: TCanvas; const Points: array of TPoint);
  371. begin
  372.   Windows.PolyBezierTo(ACanvas.Handle, PPoints(@Points)^, High(Points) + 1);
  373. end;
  374.  
  375. {$ENDIF}
  376.  
  377. //------------------------------------------------------------------------------
  378.  
  379. // *** TGmBaseObject ***
  380.  
  381. constructor TGmBaseObject.Create;
  382. begin
  383.   inherited Create;
  384.   FPrintThisObject := True;
  385. end;
  386.  
  387. procedure TGmBaseObject.Assign(Source: TGmBaseObject);
  388. begin
  389.   FShapeID := Source.FShapeID;
  390.   FRect := Source.FRect;
  391.   FPrintThisObject := Source.PrintThisObject;
  392.   FBrush := Source.FBrush;
  393.   FFont := Source.FFont;
  394.   FPen := Source.FPen;
  395. end;
  396.  
  397. procedure TGmBaseObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  398. var
  399.   ClipRgn: HRGN;
  400. begin
  401.   if FClipObject then
  402.   begin
  403.     with FClipRect do
  404.       ClipRgn := CreateRectRgn(Round(ConvertValue(Left, gmUnits, GmInches)  * DrawDpi),
  405.                                Round(ConvertValue(Top, gmUnits, GmInches)   * DrawDpi),
  406.                                Round(ConvertValue(Right, gmUnits, GmInches) * DrawDpi),
  407.                                Round(ConvertValue(Bottom, gmUnits, GmInches)* DrawDpi));
  408.     try
  409.       if MarginRgn <> 0 then
  410.         CombineRgn(ClipRgn, MarginRgn, ClipRgn, RGN_AND);
  411.       SelectClipRgn(ACanvas.Handle, ClipRgn);
  412.     finally
  413.       DeleteObject(ClipRgn);
  414.     end;
  415.   end
  416.   else
  417.     SelectClipRgn(ACanvas.Handle, MarginRgn);
  418. end;
  419.  
  420. procedure TGmBaseObject.SaveToStream(AStream: TStream);
  421. var
  422.   GmStream: TGmExtStream;
  423. begin
  424.   AStream.WriteBuffer(FShapeID, SizeOf(FShapeID));
  425.   GmStream := TGmExtStream.Create;
  426.   try
  427.     GmStream.WriteInteger(X);
  428.     GmStream.WriteInteger(Y);
  429.     GmStream.WriteBoolean(FPrintThisObject);
  430.     GmStream.WriteBoolean(FClipObject);
  431.     if FClipObject then GmStream.WriteRect(FClipRect);
  432.   finally
  433.     GmStream.SaveToStream(AStream);
  434.     GmStream.Free;
  435.   end;
  436. end;
  437.  
  438. procedure TGmBaseObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  439. var
  440.   GmStream: TGmExtStream;
  441. begin
  442.   GmStream := TGmExtStream.Create;
  443.   try
  444.     GmStream.LoadFromStream(AStream);
  445.     X := GmStream.ReadInteger;
  446.     Y := GmStream.ReadInteger;
  447.     if AVersion < 2.60 then Exit;
  448.     FPrintThisObject := GmStream.ReadBoolean;
  449.     FClipObject := GmStream.ReadBoolean;
  450.     if FClipObject then FClipRect := GmStream.ReadRect;
  451.   finally
  452.     GmStream.Free;
  453.   end;
  454. end;
  455.  
  456. procedure TGmBaseObject.OffsetObject(inchX, inchY: Extended);
  457. begin
  458.   X := X   + Round(ConvertValue(inchX, GmInches, GmUnits));
  459.   Y := Y   + Round(ConvertValue(inchY, GmInches, GmUnits));
  460.   X2 := X2 + Round(ConvertValue(inchX, GmInches, GmUnits));
  461.   Y2 := Y2 + Round(ConvertValue(inchY, GmInches, GmUnits));
  462. end;
  463.  
  464. procedure TGmBaseObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  465. var
  466.   ClipRgn: HRGN;
  467.   PpiX, PPiY: integer;
  468. begin
  469.   PpiX := APrinter.PrinterPpiX;
  470.   PpiY := APrinter.PrinterPpiY;
  471.   if FClipObject then
  472.   begin
  473.     with FClipRect do
  474.       ClipRgn := CreateRectRgn(Round(ConvertValue(Left, gmUnits, GmInches)  * PpiX) - APrinter.Offset.x,
  475.                                Round(ConvertValue(Top, gmUnits, GmInches)   * PpiY) - APrinter.Offset.y,
  476.                                Round(ConvertValue(Right, gmUnits, GmInches) * PpiX) - APrinter.Offset.x,
  477.                                Round(ConvertValue(Bottom, gmUnits, GmInches)* PpiY) - APrinter.Offset.y);
  478.     try
  479.       if MarginRgn <> 0 then
  480.         CombineRgn(ClipRgn, MarginRgn, ClipRgn, RGN_AND);
  481.       SelectClipRgn(APrinter.Canvas.Canvas.Handle, ClipRgn);
  482.     finally
  483.       DeleteObject(ClipRgn);
  484.     end;
  485.   end
  486.   else
  487.     SelectClipRgn(APrinter.Canvas.Canvas.Handle, MarginRgn);
  488. end;
  489.  
  490. function TGmBaseObject.GetX: integer;
  491. begin
  492.   Result := FRect.Left;
  493. end;
  494.  
  495. function TGmBaseObject.GetX2: integer;
  496. begin
  497.   Result := FRect.Right;
  498. end;
  499.  
  500. function TGmBaseObject.GetY: integer;
  501. begin
  502.   Result := FRect.Top;
  503. end;
  504.  
  505. function TGmBaseObject.GetY2: integer;
  506. begin
  507.   Result := FRect.Bottom;
  508. end;
  509.  
  510. procedure TGmBaseObject.SetX(const NewX: integer);
  511. begin
  512.   FRect.Left := NewX;
  513. end;
  514.  
  515. procedure TGmBaseObject.SetX2(const NewX2: integer);
  516. begin
  517.   FRect.Right := NewX2;
  518. end;
  519.  
  520. procedure TGmBaseObject.SetY(const NewY: integer);
  521. begin
  522.   FRect.Top := NewY;
  523. end;
  524.  
  525. procedure TGmBaseObject.SetY2(const NewY2: integer);
  526. begin
  527.   FRect.Bottom := NewY2;
  528. end;
  529.  
  530. //------------------------------------------------------------------------------
  531.  
  532. // *** TGmTextObject ***
  533.  
  534. constructor TGmTextObject.Create;
  535. begin
  536.   inherited Create;
  537.   FShapeID := GM_TEXT_ID;
  538. end;
  539.  
  540. procedure TGmTextObject.Assign(Source: TGmBaseObject);
  541. var
  542.   ATextObject: TGmTextObject;
  543. begin
  544.   inherited Assign(Source);
  545.   ATextObject := (Source as TGmTextObject);
  546.   FCaption := ATextObject.FCaption;
  547. end;
  548.  
  549. procedure TGmTextObject.SaveToStream(AStream: TStream);
  550. var
  551.   GmStream: TGmExtStream;
  552. begin
  553.   inherited SaveToStream(AStream);
  554.   GmStream := TGmExtStream.Create;
  555.   try
  556.     GmStream.WriteBrush(FBrush);
  557.     GmStream.WriteStr(FCaption);
  558.     GmStream.WriteFont(FFont);
  559.     GmStream.WriteByte(Ord(FAlignment));
  560.   finally
  561.     GmStream.SaveToStream(AStream);
  562.     GmStream.Free;
  563.   end;
  564. end;
  565.  
  566. procedure TGmTextObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  567. var
  568.   GmStream: TGmExtStream;
  569. begin
  570.   inherited LoadFromStream(AVersion, AStream);
  571.   GmStream := TGmExtStream.Create;
  572.   try
  573.     GmStream.LoadFromStream(AStream);
  574.     FBrush    := GmStream.ReadBrush;
  575.     FCaption  := GmStream.ReadStr;
  576.     FFont     := GmStream.ReadFont;
  577.     FAlignment := taLeftJustify;
  578.     if AVersion >= 2.60 then GmStream.ReadByte;
  579.   finally
  580.     GmStream.Free;
  581.   end;
  582. end;
  583.  
  584. procedure TGmTextObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  585. var
  586.   Top, Left: integer;
  587.   ACaption: string;
  588.   NewFont: HFont;
  589.   OldFont: HFont;
  590. begin
  591.   Left  := Round(ConvertValue(X, GmUnits, GmInches)*DrawDpi);
  592.   Top   := Round(ConvertValue(Y, GmUnits, GmInches)*DrawDpi);
  593.   ACanvas.Font.PixelsPerInch := DrawDpi;
  594.   GmFontToFont(ACanvas.Font, FFont);
  595.   GmBrushToBrush(ACanvas.Brush, FBrush);
  596.  
  597.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  598.  
  599.   ACaption := TGmPreview(FPreview).Tokenize(FCaption, FPreviewPage);
  600.  
  601.   if FFont.Angle = 0 then
  602.   begin
  603.       case FAlignment of
  604.       taLeftJustify : ACanvas.TextOut(Left, Top, ACaption);
  605.       taCenter      : ACanvas.TextOut(Left - (ACanvas.TextWidth(ACaption) div 2), Top, ACaption);
  606.       taRightJustify: ACanvas.TextOut(Left - ACanvas.TextWidth(ACaption), Top, ACaption);
  607.     end;
  608.     Exit;
  609.   end;
  610.  
  611.   NewFont := SelectFontIntoCanvas(ACanvas.Font, Font.Angle, ACanvas);
  612.   try
  613.       OldFont := SelectObject(ACanvas.Handle, NewFont);
  614.  
  615.       case FAlignment of
  616.       taLeftJustify : ACanvas.TextOut(Left, Top, ACaption);
  617.       taCenter      : ACanvas.TextOut(Left - (ACanvas.TextWidth(ACaption) div 2), Top, ACaption);
  618.       taRightJustify: ACanvas.TextOut(Left - ACanvas.TextWidth(ACaption), Top, ACaption);
  619.     end;
  620.        SelectObject(ACanvas.Handle, OldFont);
  621.   finally
  622.     DeleteObject(NewFont);
  623.   end;
  624. end;
  625.  
  626. procedure TGmTextObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  627. var
  628.   inchX, inchY: Extended;
  629. begin
  630.   if not FPrintThisObject then Exit;
  631.   inherited Print(APrinter, MarginRgn);
  632.   if (Self is TGmTextBoxObject) then Exit;
  633.   inchX := ConvertValue(X, GmUnits, GmInches);
  634.   inchY := ConvertValue(Y, GmUnits, GmInches);
  635.   APrinter.Canvas.FontAngle := FFont.Angle;
  636.   try
  637.     GmFontToFont(APrinter.Canvas.Font, FFont);
  638.     GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  639.     APrinter.Canvas.TextOut(inchX, inchY, FAlignment, FCaption);
  640.   finally
  641.     APrinter.Canvas.FontAngle := 0;
  642.   end;
  643. end;
  644.  
  645. procedure TGmTextObject.SetBrushColor(AColor: TColor);
  646. begin
  647.   if FBrush.Color <> AColor then
  648.   begin
  649.     FBrush.Style := bsSolid;
  650.     FBrush.Color := AColor;
  651.     Changed;
  652.   end;
  653. end;
  654.  
  655. procedure TGmTextObject.SetBrushStyle(AStyle: TBrushStyle);
  656. begin
  657.   if FBrush.Style <> AStyle then
  658.   begin
  659.     FBrush.Style := AStyle;
  660.     Changed;
  661.   end;
  662. end;
  663.  
  664. procedure TGmTextObject.SetTextAngle(AValue: Extended);
  665. begin
  666.   if FFont.Angle <> AValue then
  667.   begin
  668.     FFont.Angle := AValue;
  669.     Changed;
  670.   end;
  671. end;
  672.  
  673. procedure TGmTextObject.SetFontColor(AColor: TColor);
  674. begin
  675.   if FFont.Color <> AColor then
  676.   begin
  677.     FFont.Color := AColor;
  678.     Changed;
  679.   end;
  680. end;
  681.  
  682. //------------------------------------------------------------------------------
  683.  
  684. // *** TGmTextBoxObject ***
  685.  
  686. constructor TGmTextBoxObject.Create;
  687. begin
  688.   inherited Create;
  689.   FShapeID := GM_TEXTBOX_ID;
  690.   FWordBreak := True;
  691. end;
  692.  
  693. //------------------------------------------------------------------------------
  694.  
  695. procedure TGmTextBoxObject.Assign(Source: TGmBaseObject);
  696. var
  697.   ATextObject: TGmTextObject;
  698. begin
  699.   inherited Assign(Source);
  700.   ATextObject := (Source as TGmTextObject);
  701.   FCaption := ATextObject.FCaption;
  702. end;
  703.  
  704. procedure TGmTextBoxObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  705. var
  706.   ARect: TRect;
  707.   AWordBreak: Byte;
  708. begin
  709.   if not FWordBreak then AWordBreak := 0 else AWordBreak := DT_WORDBREAK;
  710.   with ACanvas do
  711.   begin
  712.     ACanvas.Font.PixelsPerInch := DrawDpi;
  713.     GmBrushToBrush(Brush, FBrush);
  714.     GmFontToFont(Font, FFont);
  715.     GmPenToPen(ACanvas, Pen, FPen);
  716.  
  717.     // calculate the destination rectangle...
  718.     ARect.Left    := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  719.     ARect.Top     := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  720.     ARect.Right   := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  721.     ARect.Bottom  := Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  722.     Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  723.     Brush.Style := bsClear;
  724.     Windows.DrawText(Handle,
  725.                      PChar(FCaption),
  726.                        Length(FCaption),
  727.                        ARect,
  728.                        DT_NOPREFIX+
  729.                      AWordBreak+
  730.                      ConvertAlignment(FAlignment)+
  731.                      ConvertVertAlignment(FVertAlignment)+
  732.                      DT_EXPANDTABS);
  733.   end;
  734. end;
  735.  
  736. procedure TGmTextBoxObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  737. var
  738.   GmStream: TGmExtStream;
  739. begin
  740.   inherited LoadFromStream(AVersion, AStream);
  741.   GmStream := TGmExtStream.Create;
  742.   try
  743.     GmStream.LoadFromStream(AStream);
  744.     FAlignment := TAlignment(GmStream.ReadInteger);
  745.     X2        := GmStream.ReadInteger;
  746.     Y2        := GmStream.ReadInteger;
  747.     FPen       := GmStream.ReadPen;
  748.   finally
  749.     GmStream.Free;
  750.   end;
  751. end;
  752.  
  753. procedure TGmTextBoxObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  754. var
  755.   AWordBreak: Byte;
  756.   inchRect: TGmRect;
  757. begin
  758.   if not FPrintThisObject then Exit;
  759.   inherited Print(APrinter, MarginRgn);
  760.   if not FWordBreak then AWordBreak := 0 else AWordBreak := DT_WORDBREAK;
  761.   inchRect.Left   := ConvertValue(X, GmUnits, GmInches);
  762.   inchRect.Top    := ConvertValue(Y, GmUnits, GmInches);
  763.   inchRect.Right  := ConvertValue(X2, GmUnits, GmInches);
  764.   inchRect.Bottom := ConvertValue(Y2, GmUnits, GmInches);
  765.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  766.   GmFontToFont(APrinter.Canvas.Font, FFont);
  767.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  768.   APrinter.Canvas.TextBoxOut(inchRect, FAlignment, FVertAlignment, AWordBreak, FCaption);
  769. end;
  770.  
  771. procedure TGmTextBoxObject.SaveToStream(AStream: TStream);
  772. var
  773.   GmStream: TGmExtStream;
  774. begin
  775.   inherited SaveToStream(AStream);
  776.   GmStream := TGmExtStream.Create;
  777.   try
  778.     GmStream.WriteInteger(Ord(FAlignment));
  779.     GmStream.WriteInteger(X2);
  780.     GmStream.WriteInteger(Y2);
  781.     GmStream.WritePen(FPen);
  782.   finally
  783.     GmStream.SaveToStream(AStream);
  784.     GmStream.Free;
  785.   end;
  786. end;
  787.  
  788. //------------------------------------------------------------------------------
  789.  
  790. constructor TGmGraphicObject.Create;
  791. begin
  792.   inherited Create;
  793.   FShapeID := GM_GRAPHIC_ID;
  794.   FDrawAsBitmap := False;
  795.   FPrintAsBitmap := False;
  796.   FCopyMode := SRCCOPY;
  797. end;
  798.  
  799. destructor TGmGraphicObject.Destroy;
  800. begin
  801.   if Assigned(FGraphic) then FGraphic.Free;
  802.   inherited;
  803. end;
  804.  
  805. //------------------------------------------------------------------------------
  806.  
  807. // *** Private functions ***
  808.  
  809. function TGmGraphicObject.GetGraphicType: TGmGraphicType;
  810. begin
  811.   if (FGraphic is TBitmap)    then Result := gtBitmap else
  812.   if (FGraphic is TIcon)      then Result := gtIcon else
  813.   if (FGraphic is TJPEGImage) then Result := gtJPeg else
  814.     Result := gtMetafile;
  815. end;
  816.  
  817. procedure TGmGraphicObject.SetGraphic(const AGraphic: TGraphic);
  818. begin
  819.   if (AGraphic is TBitmap) then
  820.   begin
  821.     FGraphic := TBitmap.Create;
  822.     (FGraphic as TBitmap).PixelFormat := pf24Bit;
  823.   end;
  824.   if (AGraphic is TMetafile)  then FGraphic := TMetafile.Create;
  825.   if (AGraphic is TJPegImage) then FGraphic := TJPEGImage.Create;
  826.   FGraphic.Assign(AGraphic);
  827. end;
  828.  
  829. //------------------------------------------------------------------------------
  830.  
  831. // *** Public functions ***
  832.  
  833. procedure TGmGraphicObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  834. var
  835.   ARect: TRect;
  836.   ABitmap: TBitmap;
  837. begin
  838.   ARect.Left    := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  839.   ARect.Top     := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  840.   ARect.Right   := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  841.   ARect.Bottom  := Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  842.   ACanvas.CopyMode := FCopyMode;
  843.   ACanvas.Brush.Style := bsSolid;
  844.   if (FDrawAsBitmap) and (FGraphic is TMetafile) then
  845.   begin
  846.     ABitmap := MetafileToBitmap(ARect.Right-ARect.Left,
  847.                                 ARect.Bottom-ARect.Top,
  848.                                 (FGraphic as TMetafile));
  849.     try
  850.       ACanvas.StretchDraw(ARect, ABitmap);
  851.     finally
  852.       ABitmap.Free;
  853.     end;
  854.   end
  855.   else
  856.     ACanvas.StretchDraw(ARect, FGraphic);
  857. end;
  858.  
  859. procedure TGmGraphicObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  860. var
  861.   GmStream: TGmExtStream;
  862.   AType: TGmGraphicType;
  863. begin
  864.   inherited LoadFromStream(AVersion, AStream);
  865.   GmStream := TGmExtStream.Create;
  866.   try
  867.       GmStream.LoadFromStream(AStream);
  868.       X2 := GmStream.ReadInteger;
  869.       Y2 := GmStream.ReadInteger;
  870.       FDrawAsBitmap := GmStream.ReadBoolean;
  871.       AType := TGmGraphicType(GmStream.ReadInteger);
  872.  
  873.       case AType of
  874.         gtMetafile: FGraphic := TMetafile.Create;
  875.         gtBitmap  : FGraphic := TBitmap.Create;
  876.         gtJPeg    : FGraphic := TJPEGImage.Create;
  877.         gtIcon    : FGraphic := TIcon.Create;
  878.       end;
  879.       FGraphic.LoadFromStream(GmStream);
  880.  
  881.       // bug-fix introduced in v2.32...
  882.       FCopyMode := cmSrcCopy;
  883.       if AVersion >= 2.32 then FCopyMode := GmStream.ReadInteger;
  884.       if AVersion >= 2.42 then FPrintAsBitmap := GmStream.ReadBoolean;
  885.     finally
  886.     GmStream.Free;
  887.   end;
  888. end;
  889.  
  890. procedure TGmGraphicObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  891. var
  892.   ARect: TGmRect;
  893. begin
  894.   if not FPrintThisObject then Exit;
  895.   inherited Print(APrinter, MarginRgn);
  896.   ARect.Left    := ConvertValue(X, GmUnits, GmInches);
  897.   ARect.Top     := ConvertValue(Y, GmUnits, GmInches);
  898.   ARect.Right   := ConvertValue(X2, GmUnits, GmInches);
  899.   ARect.Bottom  := ConvertValue(Y2, GmUnits, GmInches);
  900.   APrinter.Canvas.CopyMode := FCopyMode;
  901.   APrinter.Canvas.StretchDraw(ARect, FGraphic);
  902. end;
  903.  
  904. procedure TGmGraphicObject.SaveToStream(AStream: TStream);
  905. var
  906.   GmStream: TGmExtStream;
  907. begin
  908.   inherited SaveToStream(AStream);
  909.   GmStream := TGmExtStream.Create;
  910.   try
  911.     GmStream.WriteInteger(X2);
  912.     GmStream.WriteInteger(Y2);
  913.     GmStream.WriteBoolean(FDrawAsBitmap);
  914.     GmStream.WriteInteger(Ord(GetGraphicType));
  915.     Graphic.SaveToStream(GmStream);
  916.     GmStream.WriteInteger(FCopyMode);
  917.     GmStream.WriteBoolean(FPrintAsBitmap);
  918.   finally
  919.     GmStream.SaveToStream(AStream);
  920.     GmStream.Free;
  921.   end;
  922. end;
  923.  
  924. //------------------------------------------------------------------------------
  925.  
  926. // *** TGmLineObject ***
  927.  
  928. constructor TGmLineObject.Create;
  929. begin
  930.   inherited Create;
  931.   FShapeID := GM_LINE_ID;
  932.   FLineType:= GmLine;
  933. end;
  934.  
  935. procedure TGmLineObject.Assign(Source: TGmBaseObject);
  936. var
  937.   ALineObject: TGmLineObject;
  938. begin
  939.   inherited Assign(Source);
  940.   ALineObject := (Source as TGmLineObject);
  941.   FLineType := ALineObject.FLineType;
  942. end;
  943.  
  944. procedure TGmLineObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  945. var
  946.   GmStream: TGmExtStream;
  947. begin
  948.   inherited LoadFromStream(AVersion, AStream);
  949.   GmStream := TGmExtStream.Create;
  950.   try
  951.     GmStream.LoadFromStream(AStream);
  952.     FPen      := GmStream.ReadPen;
  953.     X2       := GmStream.ReadInteger;
  954.     Y2       := GmStream.ReadInteger;
  955.     FLineType := TGmLineType(GmStream.ReadInteger);
  956.   finally
  957.     GmStream.Free;
  958.   end;
  959. end;
  960.  
  961. procedure TGmLineObject.SaveToStream(AStream: TStream);
  962. var
  963.   GmStream: TGmExtStream;
  964. begin
  965.   inherited SaveToStream(AStream);
  966.   GmStream := TGmExtStream.Create;
  967.   try
  968.     GmStream.WritePen(FPen);
  969.     GmStream.WriteInteger(X2);
  970.     GmStream.WriteInteger(Y2);
  971.     GmStream.WriteInteger(Ord(FLineType));
  972.   finally
  973.     GmStream.SaveToStream(AStream);
  974.     GmStream.Free;
  975.   end;
  976. end;
  977.  
  978. procedure TGmLineObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  979. var
  980.   MoveTo, LineTo: TPoint;
  981. begin
  982.   MoveTo.X := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  983.   MoveTo.Y := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  984.   LineTo.X := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  985.   LineTo.Y := Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  986.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  987.   //SelectPenIntoCanvas(ACanvas.Pen, ACanvas);
  988.   ACanvas.Polyline([MoveTo, LineTo]);
  989. end;
  990.  
  991. procedure TGmLineObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  992. var
  993.   AMoveTo, ALineTo: TGmPoint;
  994. begin
  995.   if not FPrintThisObject then Exit;
  996.   inherited Print(APrinter, MarginRgn);
  997.   AMoveTo.x := ConvertValue(X, GmUnits, GmInches);
  998.   AMoveTo.y := ConvertValue(Y, GmUnits, GmInches);
  999.   ALineTo.x := ConvertValue(X2, GmUnits, GmInches);
  1000.   ALineTo.y := ConvertValue(Y2, GmUnits, GmInches);
  1001.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1002.   APrinter.Canvas.MoveTo(AMoveTo.x, AMoveTo.y);
  1003.   APrinter.Canvas.LineTo(ALineTo.x, ALineTo.y);
  1004. end;
  1005.  
  1006. //------------------------------------------------------------------------------
  1007.  
  1008. // *** TGmSimpleShape ***
  1009.  
  1010. procedure TGmSimpleShape.SaveToStream(AStream: TStream);
  1011. var
  1012.   GmStream: TGmExtStream;
  1013. begin
  1014.   inherited SaveToStream(AStream);
  1015.   GmStream := TGmExtStream.Create;
  1016.   try
  1017.     GmStream.WriteBrush(FBrush);
  1018.     GmStream.WritePen(FPen);
  1019.     GmStream.WriteInteger(X2);
  1020.     GmStream.WriteInteger(Y2);
  1021.   finally
  1022.     GmStream.SaveToStream(AStream);
  1023.     GmStream.Free;
  1024.   end;
  1025. end;
  1026.  
  1027. procedure TGmSimpleShape.LoadFromStream(AVersion: Extended; AStream: TStream);
  1028. var
  1029.   GmStream: TGmExtStream;
  1030. begin
  1031.   inherited LoadFromStream(AVersion, AStream);
  1032.   GmStream := TGmExtStream.Create;
  1033.   try
  1034.     GmStream.LoadFromStream(AStream);
  1035.     FBrush := GmStream.ReadBrush;
  1036.     FPen   := GmStream.ReadPen;
  1037.     X2    := GmStream.ReadInteger;
  1038.     Y2    := GmStream.ReadInteger;
  1039.   finally
  1040.     GmStream.Free;
  1041.   end;
  1042. end;
  1043.  
  1044. procedure TGmSimpleShape.AssignBrush(ABrush: TBrush);
  1045. begin
  1046.   FBrush.Color := ABrush.Color;
  1047.   FBrush.Style := ABrush.Style;
  1048. end;
  1049.  
  1050. procedure TGmSimpleShape.AssignPen(APen: TPen);
  1051. begin
  1052.   FPen.Color := APen.Color;
  1053.   FPen.Style := APen.Style;
  1054.   FPen.Width := APen.Width;
  1055.   FPen.Mode  := APen.Mode;
  1056. end;
  1057.  
  1058. procedure TGmSimpleShape.SetBrushColor(AColor: TColor);
  1059. begin
  1060.   FBrush.Color := AColor;
  1061. end;
  1062.  
  1063. procedure TGmSimpleShape.SetBrushStyle(AStyle: TBrushStyle);
  1064. begin
  1065.   FBrush.Style := AStyle;
  1066. end;
  1067.  
  1068. procedure TGmSimpleShape.SetPenColor(AColor: TColor);
  1069. begin
  1070.   FPen.Color := AColor;
  1071. end;
  1072.  
  1073. procedure TGmSimpleShape.SetPenStyle(AStyle: TPenStyle);
  1074. begin
  1075.   FPen.Style := AStyle;
  1076. end;
  1077.  
  1078. procedure TGmSimpleShape.SetPenWidth(AWidth: Integer);
  1079. begin
  1080.   FPen.Width := AWidth;
  1081. end;
  1082.  
  1083. procedure TGmSimpleShape.SetPenMode(AMode: TPenMode);
  1084. begin
  1085.   FPen.Mode := AMode;
  1086. end;
  1087.  
  1088. //------------------------------------------------------------------------------
  1089.  
  1090. // *** TGmEllipseShape ***
  1091.  
  1092. constructor TGmEllipseShape.Create;
  1093. begin
  1094.   inherited;
  1095.   FShapeID := GM_ELLIPSE_ID;
  1096. end;
  1097.  
  1098. procedure TGmEllipseShape.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1099. var
  1100.   ARect: TRect;
  1101. begin
  1102.   ARect.Left  := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  1103.   ARect.Top   := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  1104.   ARect.Right := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  1105.   ARect.Bottom:= Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  1106.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1107.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1108.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  1109.   with ARect do ACanvas.Ellipse(Left, Top, Right, Bottom);
  1110. end;
  1111.  
  1112. procedure TGmEllipseShape.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1113. var
  1114.   ARect: TGmRect;
  1115. begin
  1116.   if not FPrintThisObject then Exit;
  1117.   inherited Print(APrinter, MarginRgn);
  1118.   ARect.Left   := ConvertValue(X, GmUnits, GmInches);
  1119.   ARect.Top    := ConvertValue(Y, GmUnits, GmInches);
  1120.   ARect.Right  := ConvertValue(X2, GmUnits, GmInches);
  1121.   ARect.Bottom := ConvertValue(Y2, GmUnits, GmInches);
  1122.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1123.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1124.   APrinter.Canvas.Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  1125. end;
  1126.  
  1127. //------------------------------------------------------------------------------
  1128.  
  1129. // *** TGmRectangleShape ***
  1130.  
  1131. constructor TGmRectangleShape.Create;
  1132. begin
  1133.   inherited Create;
  1134.   FShapeID := GM_RECTANGLE_ID;
  1135.   FRectType := gmRectangle;
  1136. end;
  1137.  
  1138. procedure TGmRectangleShape.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1139. var
  1140.   ARect: TRect;
  1141. begin
  1142.   ARect.Left  := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  1143.   ARect.Top   := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  1144.   ARect.Right := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  1145.   ARect.Bottom:= Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  1146.  
  1147.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1148.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1149.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  1150.  
  1151.   if (FRectType = gmRectangle)  then
  1152.   begin
  1153.     ACanvas.Polygon([Point(ARect.Left, ARect.Top),
  1154.                      Point(ARect.Right, ARect.Top),
  1155.                      Point(ARect.Right, ARect.Bottom),
  1156.                      Point(ARect.Left, ARect.Bottom)]);
  1157.   end
  1158.     else if FRectType = gmFillRect then
  1159.       ACanvas.FillRect(ARect);
  1160. end;
  1161.  
  1162. procedure TGmRectangleShape.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1163. var
  1164.   ARect: TGmRect;
  1165. begin
  1166.   if not FPrintThisObject then Exit;
  1167.   inherited Print(APrinter, MarginRgn);
  1168.   ARect.Left   := ConvertValue(X, GmUnits, GmInches);
  1169.   ARect.Top    := ConvertValue(Y, GmUnits, GmInches);
  1170.   ARect.Right  := ConvertValue(X2, GmUnits, GmInches);
  1171.   ARect.Bottom := ConvertValue(Y2, GmUnits, GmInches);
  1172.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1173.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1174.   APrinter.Canvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  1175. end;
  1176.  
  1177. //------------------------------------------------------------------------------
  1178.  
  1179. // *** TGmRoundRectShape ***
  1180.  
  1181. constructor TGmRoundRectShape.Create;
  1182. begin
  1183.   inherited;
  1184.   FShapeID := GM_ROUNDRECT_ID;
  1185. end;
  1186.  
  1187. procedure TGmRoundRectShape.Assign(Source: TGmBaseObject);
  1188. var
  1189.   ARoundRect: TGmRoundRectShape;
  1190. begin
  1191.   inherited Assign(Source);
  1192.   ARoundRect := (Source as TGmRoundRectShape);
  1193.   FX3 := ARoundRect.FX3;
  1194.   FY3 := ARoundRect.FY3;
  1195. end;
  1196.  
  1197. procedure TGmRoundRectShape.SaveToStream(AStream: TStream);
  1198. var
  1199.   GmStream: TGmExtStream;
  1200. begin
  1201.   inherited SaveToStream(AStream);
  1202.   GmStream := TGmExtStream.Create;
  1203.   try
  1204.     GmStream.WriteInteger(FX3);
  1205.     GmStream.WriteInteger(FY3);
  1206.   finally
  1207.     GmStream.SaveToStream(AStream);
  1208.     GmStream.Free;
  1209.   end;
  1210. end;
  1211.  
  1212. procedure TGmRoundRectShape.LoadFromStream(AVersion: Extended; AStream: TStream);
  1213. var
  1214.   GmStream: TGmExtStream;
  1215. begin
  1216.   inherited LoadFromStream(AVersion, AStream);
  1217.   GmStream := TGmExtStream.Create;
  1218.   try
  1219.     GmStream.LoadFromStream(AStream);
  1220.     FX3 := GmStream.ReadInteger;
  1221.     FY3 := GmStream.ReadInteger;
  1222.   finally
  1223.     GmStream.Free;
  1224.   end;
  1225. end;
  1226.  
  1227. procedure TGmRoundRectShape.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1228. var
  1229.   ARect: TRect;
  1230.   ACorner: TPoint;
  1231. begin
  1232.   ARect.Left  := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  1233.   ARect.Top   := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  1234.   ARect.Right := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  1235.   ARect.Bottom:= Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  1236.   ACorner.X   := Round(ConvertValue(X3, GmUnits, GmInches) * DrawDpi);
  1237.   ACorner.Y   := Round(ConvertValue(Y3, GmUnits, GmInches) * DrawDpi);
  1238.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1239.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1240.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  1241.   with ARect do ACanvas.RoundRect(Left, Top, Right, Bottom, ACorner.X, ACorner.Y);
  1242. end;
  1243.  
  1244. procedure TGmRoundRectShape.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1245. var
  1246.   ARect: TGmRect;
  1247.   ACorner: TGmPoint;
  1248. begin
  1249.   if not FPrintThisObject then Exit;
  1250.   inherited Print(APrinter, MarginRgn);
  1251.   ARect.Left   := ConvertValue(X, GmUnits, GmInches);
  1252.   ARect.Top    := ConvertValue(Y, GmUnits, GmInches);
  1253.   ARect.Right  := ConvertValue(X2, GmUnits, GmInches);
  1254.   ARect.Bottom := ConvertValue(Y2, GmUnits, GmInches);
  1255.   ACorner.x    := ConvertValue(X3, GmUnits, GmInches);
  1256.   ACorner.y    := ConvertValue(Y3, GmUnits, GmInches);
  1257.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1258.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1259.   with ARect do
  1260.     APrinter.Canvas.RoundRect(Left, Top, Right, Bottom, ACorner.x, ACorner.y);
  1261. end;
  1262.  
  1263. //------------------------------------------------------------------------------
  1264.  
  1265. // *** TGmComplexShape ***
  1266.  
  1267. function TGmComplexShape.GetComplexPoints: TGmComplexPoints;
  1268. begin
  1269.   Result[1] := X;
  1270.   Result[2] := Y;
  1271.   Result[3] := X2;
  1272.   Result[4] := Y2;
  1273.   Result[5] := X3;
  1274.   Result[6] := Y3;
  1275.   Result[7] := X4;
  1276.   Result[8] := Y4;
  1277. end;
  1278.  
  1279. procedure TGmComplexShape.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1280. var
  1281.   I1, I2, I3, I4, I5, I6, I7, I8: integer;
  1282. begin
  1283.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1284.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1285.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  1286.   I1 := Round(ConvertValue(X, GmUnits, GmInches) * DrawDpi);
  1287.   I2 := Round(ConvertValue(Y, GmUnits, GmInches) * DrawDpi);
  1288.   I3 := Round(ConvertValue(X2, GmUnits, GmInches) * DrawDpi);
  1289.   I4 := Round(ConvertValue(Y2, GmUnits, GmInches) * DrawDpi);
  1290.   I5 := Round(ConvertValue(X3, GmUnits, GmInches) * DrawDpi);
  1291.   I6 := Round(ConvertValue(Y3, GmUnits, GmInches) * DrawDpi);
  1292.   I7 := Round(ConvertValue(X4, GmUnits, GmInches) * DrawDpi);
  1293.   I8 := Round(ConvertValue(Y4, GmUnits, GmInches) * DrawDpi);
  1294.   case FShapeID of
  1295.     GM_ARC_ID   : ACanvas.Arc(I1, I2, I3, I4, I5, I6, I7, I8);
  1296.     GM_CHORD_ID : ACanvas.Chord(I1, I2, I3, I4, I5, I6, I7, I8);
  1297.     GM_PIE_ID   : ACanvas.Pie(I1, I2, I3, I4, I5, I6, I7, I8);
  1298.   end;
  1299. end;
  1300.  
  1301. procedure TGmComplexShape.LoadFromStream(AVersion: Extended; AStream: TStream);
  1302. var
  1303.   GmStream: TGmExtStream;
  1304. begin
  1305.   inherited LoadFromStream(AVersion, AStream);
  1306.   GmStream := TGmExtStream.Create;
  1307.   try
  1308.     GmStream.LoadFromStream(AStream);
  1309.     FX3 := GmStream.ReadInteger;
  1310.     FY3 := GmStream.ReadInteger;
  1311.     FX4 := GmStream.ReadInteger;
  1312.     FY4 := GmStream.ReadInteger;
  1313.   finally
  1314.     GmStream.Free;
  1315.   end;
  1316. end;
  1317.  
  1318. procedure TGmComplexShape.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1319. var
  1320.   inchPoints: TGmComplexPoints;
  1321. begin
  1322.   if not FPrintThisObject then Exit;
  1323.   inherited Print(APrinter, MarginRgn);
  1324.   inchPoints := ConvertComplexPoints(GetComplexPoints, GmUnits, GmInches);
  1325.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1326.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1327.   case FShapeID of
  1328.     GM_ARC_ID   : APrinter.Canvas.Arc(inchPoints);
  1329.     GM_CHORD_ID : APrinter.Canvas.Chord(inchPoints);
  1330.     GM_PIE_ID   : APrinter.Canvas.Pie(inchPoints);
  1331.   end;
  1332. end;
  1333.  
  1334. procedure TGmComplexShape.SaveToStream(AStream: TStream);
  1335. var
  1336.   GmStream: TGmExtStream;
  1337. begin
  1338.   inherited SaveToStream(AStream);
  1339.   GmStream := TGmExtStream.Create;
  1340.   try
  1341.     GmStream.WriteInteger(FX3);
  1342.     GmStream.WriteInteger(FY3);
  1343.     GmStream.WriteInteger(FX4);
  1344.     GmStream.WriteInteger(FY4);
  1345.   finally
  1346.     GmStream.SaveToStream(AStream);
  1347.     GmStream.Free;
  1348.   end;
  1349. end;
  1350.  
  1351. //------------------------------------------------------------------------------
  1352.  
  1353. // *** TGmArcShape ***
  1354.  
  1355. constructor TGmArcShape.Create;
  1356. begin
  1357.   inherited Create;
  1358.   FShapeID := GM_ARC_ID;
  1359. end;
  1360.  
  1361. //------------------------------------------------------------------------------
  1362.  
  1363. // *** TGmChordShape ***
  1364.  
  1365. constructor TGmChordShape.Create;
  1366. begin
  1367.   inherited Create;
  1368.   FShapeID := GM_CHORD_ID;
  1369. end;
  1370.  
  1371. //------------------------------------------------------------------------------
  1372.  
  1373. // *** TGmPieShape ***
  1374.  
  1375. constructor TGmPieShape.Create;
  1376. begin
  1377.   inherited Create;
  1378.   FShapeID := GM_PIE_ID;
  1379. end;
  1380.  
  1381. //------------------------------------------------------------------------------
  1382.  
  1383. {$IFDEF D4+}
  1384.  
  1385. // *** TGmPolyBaseObject ***
  1386.  
  1387. procedure TGmPolyBaseObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1388.  
  1389. var
  1390.   count: integer;
  1391.   CanvasPoints: array of TPoint;
  1392. begin
  1393.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1394.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1395.   SetLength(CanvasPoints, High(Points)+1);
  1396.  
  1397.   for count := 0 to High(Points) do
  1398.   begin
  1399.     CanvasPoints[count].x := Round(ConvertValue(Points[count].x, GmUnits, GmInches) * DrawDpi);
  1400.     CanvasPoints[count].y := Round(ConvertValue(Points[count].y, GmUnits, GmInches) * DrawDpi);
  1401.   end;
  1402.   inherited Draw(ACanvas, DrawDpi, MarginRgn);
  1403.   case FShapeID of
  1404.     GM_POLYGON_ID     : DrawPolygon(ACanvas, CanvasPoints);
  1405.     GM_POLYLINE_ID    : DrawPolyLine(ACanvas, CanvasPoints);
  1406.     GM_POLYBEZIER_ID  : DrawPolyBezier(ACanvas, CanvasPoints);
  1407.     GM_POLYLINETO_ID  : DrawPolyLineTo(ACanvas, CanvasPoints);
  1408.     GM_POLYBEZIERTO_ID: DrawPolyBezierTo(ACanvas, CanvasPoints);
  1409.   end;
  1410. end;
  1411.  
  1412. procedure TGmPolyBaseObject.SaveToStream(AStream: TStream);
  1413. var
  1414.   GmStream: TGmExtStream;
  1415.   ICount: integer;
  1416. begin
  1417.   inherited SaveToStream(AStream);
  1418.   GmStream := TGmExtStream.Create;
  1419.   try
  1420.     GmStream.WriteBrush(FBrush);
  1421.     GmStream.WritePen(FPen);
  1422.     GmStream.WriteInteger(High(Points));
  1423.     for ICount := 0 to High(Points) do
  1424.     begin
  1425.       GmStream.WriteInteger(Points[ICount].X);
  1426.       GmStream.WriteInteger(Points[ICount].Y);
  1427.     end;
  1428.   finally
  1429.     GmStream.SaveToStream(AStream);
  1430.     GmStream.Free;
  1431.   end;
  1432. end;
  1433.  
  1434. procedure TGmPolyBaseObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  1435. var
  1436.   GmStream: TGmExtStream;
  1437.   ICount: integer;
  1438. begin
  1439.   inherited LoadFromStream(AVersion, AStream);
  1440.   GmStream := TGmExtStream.Create;
  1441.   try
  1442.     GmStream.LoadFromStream(AStream);
  1443.     FBrush := GmStream.ReadBrush;
  1444.     FPen   := GmStream.ReadPen;
  1445.     SetLength(Points, GmStream.ReadInteger+1);
  1446.     for ICount := 0 to High(Points) do
  1447.     begin
  1448.       Points[ICount].X := GmStream.ReadInteger;
  1449.       Points[ICount].Y := GmStream.ReadInteger;
  1450.     end;
  1451.   finally
  1452.     GmStream.Free;
  1453.   end;
  1454. end;
  1455.  
  1456. procedure TGmPolyBaseObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1457. var
  1458.   ICount: integer;
  1459.   CanvasPoints: array of TGmPoint;
  1460. begin
  1461.   if not FPrintThisObject then Exit;
  1462.   inherited Print(APrinter, MarginRgn);
  1463.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1464.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1465.  
  1466.   SetLength(CanvasPoints, High(Points)+1);
  1467.   for ICount := 0 to High(Points) do
  1468.   begin
  1469.     CanvasPoints[ICount].x := ConvertValue(Points[ICount].x, GmUnits, GmInches);
  1470.     CanvasPoints[ICount].y := ConvertValue(Points[ICount].y, GmUnits, GmInches);
  1471.   end;
  1472.  
  1473.   case FShapeID of
  1474.     GM_POLYGON_ID     : APrinter.Canvas.Polygon(CanvasPoints);
  1475.     GM_POLYLINE_ID    : APrinter.Canvas.Polyline(CanvasPoints);
  1476.     GM_POLYBEZIER_ID  : APrinter.Canvas.PolyBezier(CanvasPoints);
  1477.     GM_POLYLINETO_ID  : APrinter.Canvas.PolylineTo(CanvasPoints);
  1478.     GM_POLYBEZIERTO_ID: APrinter.Canvas.PolyBezierTo(CanvasPoints);
  1479.   end;
  1480. end;
  1481.  
  1482. //------------------------------------------------------------------------------
  1483.  
  1484. constructor TGmPolygonObject.Create;
  1485. begin
  1486.   inherited Create;
  1487.   FShapeID := GM_POLYGON_ID;
  1488. end;
  1489.  
  1490. //------------------------------------------------------------------------------
  1491.  
  1492. // *** TPolylineObject ***
  1493.  
  1494. constructor TGmPolyLineObject.Create;
  1495. begin
  1496.   inherited Create;
  1497.   FShapeID := GM_POLYLINE_ID;
  1498. end;
  1499.  
  1500. // *** TPolylineToObject ***
  1501.  
  1502. constructor TGmPolyLineToObject.Create;
  1503. begin
  1504.   inherited Create;
  1505.   FShapeID := GM_POLYLINETO_ID;
  1506. end;
  1507.  
  1508. // *** TGmPolyBezierTo ***
  1509.  
  1510. constructor TGmPolyBezierObject.Create;
  1511. begin
  1512.   inherited;
  1513.   FShapeID := GM_POLYBEZIER_ID;
  1514. end;
  1515.  
  1516. // *** TGmPolyBezierTo ***
  1517.  
  1518. constructor TGmPolyBezierToObject.Create;
  1519. begin
  1520.   inherited;
  1521.   FShapeID := GM_POLYBEZIERTO_ID;
  1522. end;
  1523.  
  1524. {$ENDIF}
  1525.  
  1526. // *** TGmPathObject ***
  1527.  
  1528. constructor TGmPathObject.Create;
  1529. begin
  1530.   inherited;
  1531.   FShapeID := GM_PATH_OBJECT_ID;
  1532. end;
  1533.  
  1534. procedure TGmPathObject.Draw(ACanvas: TCanvas; DrawDpi: integer; MarginRgn:HRGN);
  1535. begin
  1536.   GmBrushToBrush(ACanvas.Brush, FBrush);
  1537.   GmPenToPen(ACanvas, ACanvas.Pen, FPen);
  1538.   case FObjectType of
  1539.     gmBeginPath        : BeginPath(ACanvas.Handle);
  1540.     gmEndPath          : EndPath(ACanvas.Handle);
  1541.     gmFillPath         : FillPath(ACanvas.Handle);
  1542.     gmStrokePath       : StrokePath(ACanvas.Handle);
  1543.     gmStrokeAndFillPath: StrokeAndFillPath(ACanvas.Handle);
  1544.     gmCloseFigure      : CloseFigure(ACanvas.Handle);
  1545.   end;
  1546. end;
  1547.  
  1548. procedure TGmPathObject.LoadFromStream(AVersion: Extended; AStream: TStream);
  1549. var
  1550.   GmStream: TGmExtStream;
  1551. begin
  1552.   inherited LoadFromStream(AVersion, AStream);
  1553.   GmStream := TGmExtStream.Create;
  1554.   try
  1555.     GmStream.LoadFromStream(AStream);
  1556.     FBrush := GmStream.ReadBrush;
  1557.     FPen   := GmStream.ReadPen;
  1558.     FObjectType := TGmPathObjectType(GmStream.ReadByte);
  1559.   finally
  1560.     GmStream.Free;
  1561.   end;
  1562. end;
  1563.  
  1564. procedure TGmPathObject.Print(APrinter: TGmPrinter; MarginRgn: HRGN);
  1565. begin
  1566.   if not FPrintThisObject then Exit;
  1567.   inherited Print(APrinter, MarginRgn);
  1568.   GmPenToPen(nil, APrinter.Canvas.Pen, FPen);
  1569.   GmBrushToBrush(APrinter.Canvas.Brush, FBrush);
  1570.   case FObjectType of
  1571.     gmBeginPath:        APrinter.Canvas.BeginPath;
  1572.     gmEndPath:          APrinter.Canvas.EndPath;
  1573.     gmFillPath:         APrinter.Canvas.FillPath;
  1574.     gmStrokePath:       APrinter.Canvas.StrokePath;
  1575.     gmStrokeAndFillPath:APrinter.Canvas.StrokeAndFillPath;
  1576.     gmCloseFigure:      APrinter.Canvas.CloseFigure;
  1577.   end;
  1578. end;
  1579.  
  1580. procedure TGmPathObject.SaveToStream(AStream: TStream);
  1581. var
  1582.   GmStream: TGmExtStream;
  1583. begin
  1584.   inherited SaveToStream(AStream);
  1585.   GmStream := TGmExtStream.Create;
  1586.   try
  1587.     GmStream.WriteBrush(FBrush);
  1588.     GmStream.WritePen(FPen);
  1589.     GmStream.WriteByte(Ord(FObjectType));
  1590.   finally
  1591.     GmStream.SaveToStream(AStream);
  1592.     GmStream.Free;
  1593.   end;
  1594. end;
  1595.  
  1596. end.
  1597.  
  1598.  
  1599.  
  1600.  
  1601.  
  1602.  
  1603.  
  1604.